COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Gosper's checkerboard frotz - Take 2
C00003 00003	∂	Co-ordinate reducer
C00004 00004	∂	Patterns
C00006 00005	∂	Coloring rules
C00007 00006	∂	Rhombunciousness
C00008 00007	∂	Put up the current frame
C00011 00008	∂	It
C00015 00009	END "TAKE2.SAI"
C00016 ENDMK
C⊗;
Comment	Gosper's checkerboard frotz - Take 2;

BEGIN "TAKE2.SAI"

Require "HEADER[LIB,MLB]" Source_File;
Require "IOLIB[LIB,MLB]" Library;
Require "GRAFIX.HDR[GX,MLB]" Source_File;


∂	Co-ordinate reducer;

Procedure Destiny(Reference Integer X,Y);
⊂ "Destiny"
    Integer ShiftCount;
    If X=0 ∧ Y=0 Then Return;
    ShiftCount ← 0;
    While (X LAND '1)=0 ∧ (Y LAND '1)=0 Do ⊂ "Shift 00's"
	X ← X ASH -1;
	Y ← Y ASH -1;
	ShiftCount ← ShiftCount + 1;
    ⊃ "Shift 00's";
    Case ShiftCount LAND '3 Of ⊂ "Terminal Cases"
	[1] ⊂ X ↔ Y; X ← -X; ⊃;
	[2] ⊂ X ← -X; Y ← -Y; ⊃;
	[3] ⊂ X ↔ Y; Y ← -Y; ⊃
    ⊃ "Terminal Cases";
    If (X LAND '1)='1 ∧ (Y LAND '1)=1 Then ⊂ "11 Case"
	Integer TX;
	TX ← X;
	X ← (X - Y) ASH -1;
	Y ← (TX + Y) ASH -1;
    ⊃ "11 Case";
    Return;
⊃ "Destiny";

∂	Patterns;

Boolean Procedure PinWheel(Integer X,Y);
⊂ "PinWheel"
    Real p,q,r,s,t;
    Integer i;
    ∂ let's draw a pinwheel !;
    p ← π/2;			∂ rotation for whole pattern;
    q ← 1;			∂ number of arms in wheel;
    r ← SQRT(X*X+Y*Y);		∂ radius to point;
    s ← r*(π/2);		∂ spiral offset for that radius;
    t ← ATAN2(Y,X);		∂ angle for point;
    If (i ← (t-p-s)*q/π ) LAND '2 = 0
	Then Return(TRUE)
	Else Return(FALSE);
⊃ "PinWheel";

Boolean Procedure OffCircle(Integer X,Y);
⊂ "OffCircle"
    If (X-23)↑2+(Y+9)↑2 < 300
	Then Return(TRUE)
	Else Return(FALSE);
⊃ "OffCircle";

Boolean Procedure Foo(Integer X,Y);
⊂ "Foo"
    If ((X+Y) ASH -2) MOD 2 = 1
	Then Return(TRUE)
	Else Return(FALSE);
⊃ "Foo";

∂	Coloring rules;

Boolean Procedure Color(Integer X,Y);
⊂ "Color"
    Foo(X,Y);
⊃ "Color";

Boolean Procedure ColorOf(Integer X,Y);
⊂ "ColorOf"
    Destiny(X,Y);
    Return(¬Color(X,Y));
⊃ "ColorOf";

∂	Rhombunciousness;

Define Rhombus(x1,y1,x2,y2,x3,y3)={
⊂ "Rhombunciousness"
    px[0]←x0;		py[0]←y0;
    px[1]←x1+x0;	py[1]←y1+y0;
    px[2]←x2+x0;	py[2]←y2+y0;
    px[3]←x3+x0;	py[3]←y3+y0;
    POLYGO(4,px[0],py[0]);
⊃ "Rhombunciousness"
};

∂	Put up the current frame;

Procedure Frame(Integer FrameNumber,NumFrames; Real r; Integer Chan,Line);
⊂ "Frame"
Integer NumTiles,xt,yt,xt2,yt2,xx,yy;			∂ for indexing cells;
Real p,q,mp,mq,mr,ppr,mqpr,qmr,ppq,pmq,x0,y0;	∂ for finding corners of tile;
Own Real Array px[0:3],py[0:3];			∂ for rhombic polygo call;
    xx←256; yy←240;				∂ picture central;

    Erase(Chan);
    Drken; Rectan(0,0,511,480);		∂ clear picture and build frame;
    Liten; Ellips(10,30,501,450);
    Drken;

    p←r*Cos((π/2)*(FrameNumber/NumFrames));	∂ smallest angle corner x-co;
    q←sqrt(r↑2-p↑2);				∂ ditto for y-co;
    mp←-p; mq←-q; mr←-r; ppr←p+r; mqpr←-(q+r); qmr←q-r; ppq←p+q; pmq←p-q;
    NumTiles←(200/r);
    For xt←-NumTiles Thru NumTiles Do ⊂ "XLoop"
	xt2←xt+xt;
	For yt←-NumTiles Thru NumTiles Do ⊂ "YLoop"
	    yt2←yt+yt;
	    x0←ppr*xt-q*yt+xx; 
	    y0←q*xt+ppr*yt+yy;
	    If ColorOf(xt2,yt2) Then Rhombus(0,mr,mr,mr,mr,0);		∂ 0,0 cell;
	    If ColorOf(xt2+1,yt2) Then Rhombus(p,q,p,qmr,0,mr);		∂ 1,0 cell;
	    If ColorOf(xt2+1,yt2+1) Then Rhombus(p,q,pmq,ppq,mq,p);	∂ 1,1 cell;
	    If ColorOf(xt2,yt2+1) Then Rhombus(mr,0,mqpr,p,mq,p);	∂ 0,1 cell;
	⊃ "YLoop";
    ⊃ "XLoop";
    ERASE(CHAN);
    DPYUP(CHAN);
    SHOW(CHAN,LINE);
⊃ "Frame";

∂	It;

DDINIT; SCREEN(0,0,511,480);
PPPOS(0,50); PRINT(↓,↓,↓,↓,↓);                ∂ clear pp;

DoForever ⊂ "Loop de loop"
    Integer TileSize,BrkChr,I,J,MaxChan,C;
    Integer Array Channel[1:32];
    Integer DT,DC,Line;
    String S;

∂ get tile size in pixels;
    Print("Tile Radius (in pixels) ?");
    S ← INCHWL;
    If S=NULL Then Done;
    TileSize ← RealScan(S,BrkChr);

∂ get DD chans;
    MaxChan ← 0;
    DoForever ⊂ "grab dd"
	C ← GDDCHN(-1);		∂ try for a chan;
	If C<0 Then ⊂ "pop one"
		Channel[(MaxChan-1) MAX 1] ↔ Channel[MaxChan];
		RDDCHN(Channel[MaxChan]); MaxChan←MaxChan-1; Done;
	⊃ "pop one"; ∂ no more chans;
	MaxChan ← MaxChan + 1;
	Channel[MaxChan] ← C;
    ⊃ "grab dd";
    Print("You've now got ALL ",MaxChan," free Data Disc channels.",↓,
		"How many do you want to keep ? ");
    C ← IntScan(S ← INCHWL,BrkChr);
    While MaxChan>C Do
	 ⊂ RDDCHN(Channel[MaxChan]); MaxChan←MaxChan-1; ⊃;
    If MaxChan≤0 Then CALL(0,"EXIT");
    Print("OK, keeping ",MaxChan," channels.",↓);

    Print("Destination Line (RETURN means yours) ? ");
    Line ← IntScan(S ← INCHWL, BrkChr);
    If S=NULL Then Line ← -1;

    For I ← 1 Thru MaxChan Do Frame(I-1,MaxChan,TileSize,Channel[I],Line);

    DT ← 8; DC ← 1;
    DoForever ⊂ "cycle"
	SCNFRZ;
	LINSCN(MaxChan,Channel,DT,Line);
	S ← INCHRW;
        Case S of ⊂ "cases"
		["*"] DT ← (DT/2) MAX 1;
		["/"] DT ← DT*2;
		["+"] DT ← (DT - 1) MAX 1;
		["-"] DT ← DT + 1;
		["\"] SCNINC(DC ← -DC);
		ELSE DONE "cycle"
	⊃ "cases";
    ⊃ "cycle";
        SCNOFF;
        While MaxChan>0 Do ⊂ RDDCHN(Channel[MaxChan]); MaxChan←MaxChan-1; ⊃;
	CALL(0,"EXIT");
⊃ "Loop de loop";

END "TAKE2.SAI";